#lang autolisp

;(instrumenting-enabled #t)
;(profiling-enabled #t)
;(profiling-record-enabled #t)

;;Peter Ivanyi tests

  (check (+ 1 2) 3)
  (check (+ 1 2 3 4.5) 10.5)
  (check (+ 1 2 3 4.0) 10.0)
   
  (check (- 50 40) 10)
  (check (- 50 40.0) 10.0)
  (check (- 50 40 2.5) 7.5)
  (check (- 8) -8)
   
  (check (* 2 3) 6)
  (check (* 2 3.0) 6.0)
  (check (* 2 3 4.0) 24.0)
  (check (* 3 -4.5) -13.5)
  (check (* 3) 3)

  (check (/ 100 2) 50)
  (check (/ 100 2.0) 50.0)
  (check (/ 100 20.0 2) 2.5)
  (check (/ 100 20 2) 2)
  (check (/ 4) 4)
   
  (check (~ 3) -4)
   
  (check (= 4 4.0) 't)
  (check (= 20 338) 'nil)
  (check (= 2.4 2.4 2.4) 't)
  (check (= 499 499 500) 'nil)
  (check (= "me" "me") 't)
  (check (= "me" "you") 'nil)
  (check (= "you" "you" nil) 'nil)
  (check (= 4 4.0 nil 4) 'nil)
   
  (check (/= 10 20) 't)
  (check (/= "you" "you") 'nil)
  (check (/= 5.43 5.44) 't)
  (check (/= 10 20 10 20 20) 'nil)
  (check (/= 10 20 10 20) 't)
  ; integer != real
  (check (/= 10.0 10) 'nil)

  (check (< 10 20) 't)
  (check (< "b" "c") 't)
  (check (< 357 33.2) 'nil)
  (check (< 2 3 88) 't)
  (check (< 2 3 4 4) 'nil)
  (check (< 2 3 nil 4) 'nil)
   
  (check (<= 10 20) 't)
  (check (<= "b" "b") 't)
  (check (<= 357 33.2) 'nil)
  (check (<= 2 9 9) 't)
  (check (<= 2 9 4 5) 'nil)
  (check (<= 2 9 nil 4 5) 'nil)
  
  (check (> 120 17) 't)
  (check (> "c" "b") 't)
  (check (> 3.5 1792) 'nil)
  (check (> 77 4 2) 't)
  (check (> 77 4 4) 'nil)
   
  (check (>= 120 17) 't)
  (check (>= "c" "c") 't)
  (check (>= 3.5 1792) 'nil)
  (check (>= 77 4 4) 't)
  (check (>= 77 4 9) 'nil)
   
  (check (1+ 100) 101)
  (check (1+ -17.5) -16.5)
  (check (1- 100) 99)
  (check (1- -17.5) -18.5)

  ; Function A
   
  (check (abs 100) 100)
  (check (abs -100) 100)
  (check (abs -99.25) 99.25)
  
#|
  (check (alert "rr") 'nil)
  (check (alloc 100) 1124)
  (check (alloc 100) 1224)
|#  
  (check (and 1.4 103 "a") 't)
  (check (and 1.4 nil "a") 'nil)
  ; execution up to the first nil
  (check 
           (progn
             (and (setq a 1) (setq b 'nil) (setq c 3))
             c
           )
           'nil)
   
  (check (angle '(1.0 1.0) '(1.0 4.0)) 1.5708)
  (check (angle '(5.0 1.33) '(2.4 1.33)) 3.14159)
  
  (check (angtof "3.14159265" 0) 0.0548311)
  (check (angtof "3.14159265" 3) 3.14159)
  #;(check (angtof "180r" 0) 4.070811)
  #;(check (angtof "180r" 3) 4.070811)
#|
  (check (angtos 0.785398 0 4) "45.0000")
  (check (angtos -0.785398 0 4) "315.0000")
  (check (angtos -0.785398 3 4) "5.4978r")
  (check (angtos 45 0) "58")
  (check (angtos -45 0) "302")
  (check (angtos -450 0) "137")
  (check (angtos -4500 0) "289")
  (check (angtos -4500 0 4) "288.9922")
  (check (angtos -4500 3 4) "5.0439r")
  (check (angtos 4500 3 4) "1.2393r")
  (check (angtos 3.1415 0 4) "179.9947")
  (check (angtos 3.14159265 0 4) "180.0000")
|#   
#|  (check 
           (progn
             (setvar "DIMZIN" 8)
             (setq tt (angtos 4500 3 4))
             (setvar "DIMZIN" 0)
             tt
           )
           "1.2393r")
  (check 
           (progn
             (setvar "DIMZIN" 8)
             (setq tt (angtos 3.14159265 0 4))
             (setvar "DIMZIN" 0)
             tt
           )
           "180")
  |#
  (check (append '(a b) '(c d)) '(a b c d))
  (check (append '((a) (b)) '((c) (d))) '((a) (b) (c) (d)))
  (check (append nil nil) '())
  (check (append '(a b) nil) '(a b))
  (check (append nil '(a b)) '(a b))
  (check (apply '+ '(1 2 3)) 6)
  (check (apply 'strcat '("a" "b" "c")) "abc")
  (check (progn
                         (setq ffunc 'min)
                         (apply ffunc '(3 4 5 1 6 7))
                      )
                      1)
  ; FIXME: not tested properly, see chr
  (check (ascii "A") 65)
  (check (ascii "a") 97)
  (check (ascii "BIG") 66)
   
  (check 
           (assoc 'size '((name box) (size 2.3) (depth 5)))
          '(size 2.3))
  (check 
           (assoc 'weight '((name box) (size 2.3) (depth 5))) 'nil)
  (check (assoc '1 nil) 'nil)
   
  (check (atan 1) 0.785398)
  (check (atan 1.0) 0.785398)
  (check (atan 0.5) 0.463648)
  (check (atan -1.0) -0.785398)
  (check (atan 2.0 3.0) 0.588003)
  (check (atan 2.0 -3.0) 2.55359)
  (check (atan 1.0 0.0) 1.5708)
   
  (check (atof "97.1") 97.1)
  (check (atof "3") 3.0)
  (check (atof "3.9") 3.9)
  (check (atof "asd") 0.0)
  (check (atof "e1") 0.0)
  (check (atof ".e1") 0.0)
  (check (atof "2e2") 200.0)
  (check (atof "-23.as") -23.0)
  (check (atof "+23.4e-1") 2.34)
  (check (atof "+23.4e-1qw") 2.34)
  (check (atof "+23.4eq-1qw") 23.4)
   
  (check (atoi "97.1") 97)
  (check (atoi "3") 3)
  (check (atoi "3.9") 3)
  (check (atoi "b") 0)
  (check (atoi "10b") 10)
  (check (atoi "-61.23") -61)
  (check (atoi "-61e2") -61)
   
  (check (atom 'aa) 't)
  (check (atom  aa) 't)
  (check (atom '(a b c)) 'nil)
  (check (atom  1) 't)
  (check (atom  "a") 't)
  
  ; Function B
   #|
  (check (boole 1 12 5) 4)
  (check (boole 6 6 5) 3)
  (check (boole 4 3 14) 12)
  |#
  (check (progn (setq a 'nil) (boundp 'a)) 'nil)
  (check (progn (setq tt 2) (boundp 'tt)) 't)
   
  ; Function C
   
  (check (car aa) 'nil)
  (check (car nil) 'nil)
  (check (car '()) 'nil)
  (check (car '(a)) 'a)
  (check (car '((a) (b))) '(a))
 ;; (check (car 2) 'nil)  AML This doesn't make sense.
 ;; (check (car "a") 'nil)
   
  (check (cdr aa) 'nil)
  (check (cdr nil) 'nil)
  (check (cdr '()) 'nil)
  (check (cdr '(a)) '())
  (check (cdr '((a) (b))) '((b)))
;;  (check (cdr 2) 'nil) AML This doesn't make sense
;;  (check (cdr "a") 'nil)

  (check (cadr aa) 'nil)
  (check (cadr '(1 2 3)) 2)
  
  (check (cadr aa) 'nil)
  (check (caddr '(1 2 3)) 3)
   
  ; FIXME: not finished
  (check (chr 56) "8")
;;AML This looks wrong  (check (chr 1) "\\1")
  (check (chr 1) "\001")
  
  ; close is tested with extra
  ; command is tested later
  (check 
           (progn
             (setq a 10)
             (cond
               ((< a 0) -1)
               ((> a 0) 1)
               (t 0)))
           1)
  (check 
           (progn
             (setq a -10)
             (cond
               ((< a 0) -1)
               ((> a 0) 1)
               (t 0)))
           -1)
  (check 
           (progn
             (setq a 0.0)
             (cond
               ((< a 0) -1)
               ((> a 0) 1)
               (t 0)))
           0)
  
  (check (cons 1 nil) '(1))
  (check (cons 1 '()) '(1))
  (check (cons nil nil) '(nil))
  (check (cons 1 '(2 3)) '(1 2 3))
  (check (cons '(1) '(2 3)) '((1) 2 3))
  (check (cons 1 2) '(1 . 2))
  
  (check (cos 0.0) 1.0)
  (check (cos pi) -1.0)
  
  ; Function D
  
  (check 
           (progn
             (defun a (w) (+ w 1))
             (a 2)
           )
           3)
  (check 
           (progn
             (defun a (w / e) (setq e 2) (+ w e 1))
             (a 2)
           )
           5)
  (check 
           (progn
             (defun a (w / e) (setq e 2) (+ w e 1))
             (a 2)
             e
           )
           'nil)
  (check 
           (progn
             (defun a (/ e) (setq e 2) (+ e 1))
             (a)
           )
           3)
  
  ; dictionary handling is tested separately
  
  (check (distance '(1.0 2.5 3.0) '(7.7 2.5 3.0)) 6.7)
  (check (distance '(1.0 2.0 0.5) '(3.0 4.0 0.5)) 2.82843)
  ; mixed use of 2D and 3D points
  (check (distance '(0.0 1.0) '(10.0 1.0 0.0)) 10.0)
   
  (check (distof "12") 12.0)
  (check (distof "0.000001") 1e-6)
  (check (distof "12" 2) 12.0)
  (check (distof "a") 'nil)
   
  ; Function E
  
  ; entity handling is tested separately
  
  (check 
           (progn
             (setq f1 '(a b c))
             (setq f2 '(a b c))
             (setq f3 f2)
             (eq f1 f2)
           )
           'nil)
  (check 
           (progn
             (setq f1 '(a b c))
             (setq f2 '(a b c))
             (setq f3 f2)
             (eq f3 f2)
           )
           't)
  
  (check (equal nil nil) 't)
  (check (equal nil '()) 't)
  (check (equal 'nil 'nil) 't)
  (check (equal 4 4.0) 't)
  (check (equal "aa" "aa") 't)
  (check (equal "ab" "aa") 'nil)
  (check (equal 4 3.999 0.01) 't)
  (check 
           (progn
             (setq f1 '(a b c))
             (setq f2 '(a b c))
             (setq f3 f2)
             (equal f3 f2)
           )
           't)
  (check 
           (progn
             (setq f1 '(a b c))
             (setq f2 '(a b c))
             (setq f3 f2)
             (equal f1 f2)
           )
           't)
  (check (equal 3.999 4 0.01) 't)
  
  (check (eval '(abs -10)) 10)
  (check 
           (progn
             (setq a 123)
             (setq b 'a)
             (eval b)
           )
           123)
  
  (check (exp 1.0) 2.71828)
  (check (exp 2.2) 9.02501)
  (check (exp -0.4) 0.67032)
  
  (check (expt 2 4) 16)
  (check (expt 3.0 2.0) 9.0)
  
  ; Function F
  
#;  (check (findfile "no-such-file") 'nil)
  ; FIXME: this may change
#;  (check 
           (findfile "./test-autolisp.scm") 
           "c:\\peteri\\AutoCAD\\rannila\\simulator\\test-autolisp.scm")
  
  (check (fix 3) 3)
  (check (fix 3.7) 3)
  
  (check (float 3) 3.0)
  (check (float 3.75) 3.75)
  
  (check 
           (foreach n '(a b c) (princ n))
           'c)
  (check 
           (foreach n '(1 2 3) (setq n 33) (princ n))
           33)
  
  ; Function G
  
  (check (gc) 'nil)
  
  (check (gcd 81 57) 3)
  (check (gcd 12 20) 4)
  
#|  (check (getvar "OSMODE") 0)
  (check (graphscr) 'nil)
  
  (check (grclear) 'nil)
  (check (grdraw '(0.0 0.0) '(1.0 1.0) 2) 'nil)
  (check (grdraw '(0.0 0.0) '(1.0 1.0) 2 t) 'nil)
  (check (grtext) 'nil)
  (check (grtext 1 "text") "text")
|#  
  ; Function H
  
#;  (check (handent "1") "<Entity name: 100000>")
  
  ; Function I
  
  (check (if 1 1 2) 1)
  (check (if nil 1 2) 2)
  (check (if '() 1 2) 2)
  (check (if (= 2 (+ 1 1)) "YES") "YES")
  (check (if nil 2) 'nil)
  
  (check (itoa 33) "33")
  (check (itoa -17) "-17")
  #|
  (check (inters '(1.0 1.0) '(9.0 9.0) '(4.0 1.0) '(4.0 3.0)) 'nil)
  (check (inters '(1.0 1.0) '(9.0 9.0) '(4.0 1.0) '(4.0 3.0) 't) 'nil)
  (check (inters '(1.0 1.0) 
                              '(9.0 9.0) 
                              '(4.0 1.0) 
                              '(4.0 3.0) 'nil) 
           '(4.0 4.0 0.0))
  |#
  ; Function L
  
  (check (last '(a b c d e)) 'e)
  (check (last '(a b c (d e))) '(d e))
  
  (check (length '(a b c d)) 4)
  (check (length '(a b (c d))) 3)
  (check (length '()) 0)
  
  (check (list 'a 'b 'c) '(a b c))
  (check (list 'a '(b c) 'd) '(a (b c) d))
  (check (list 3.9 6.7) '(3.9 6.7))
  
  (check (listp '(a b c)) 't)
  (check (listp 'a) 'nil)
  (check (listp 4.34) 'nil)
  (check (listp nil) 't)
  (check (listp '()) 't)
  
  (check (log 4.5) 1.50408)
  (check (log 1.22) 0.198851)
  
  (check (logand 7 15 3) 3)
  (check (logand 2 3 15) 2)
  (check (logand 8 3 4) 0)
  
  (check (logior 1 2 4) 7)
  (check (logior 9 3) 11)
  
  (check (lsh 2 1) 4)
  (check (lsh 2 -1) 1)
  (check (lsh 40 2) 160)
  
  ; Function M
  
  (check (mapcar '1+ '(1 2 3)) '(2 3 4))
  (check (mapcar '(lambda (x) (+ 10 x)) '(1 2 3)) '(11 12 13))
  (check (mapcar '- '(11 12 13) '(1 2)) '(10 10))
  (check 
           (progn
             (setq pp '((a 1) (b 2) (c 3)))
             (mapcar 'car pp)
           )
           '(a b c))
  (check (mapcar 'list '()) '())
  (check (mapcar 'list nil) '())
  
  (check (max 4.07 -144) 4.07)
  (check (max -88 19 5 2) 19)
  (check (max 2.1 4 8) 8.0)
  
  (check (mem) 'nil)
  
  (check (member 'c '(a b c d e)) '(c d e))
  (check (member 'q '(a b c d e)) 'nil)
  (check (member 1.0 '(1 -1)) '(1 -1))
  
  (check (min 683 -10.0) -10.0)
  (check (min 73 2 48 5) 2)
  (check (min 73.0 2 48 5) 2.0)
  (check (min 2 4 6.7) 2.0)
  
  (check (minusp -1) 't)
  (check (minusp -4.293) 't)
  (check (minusp 830.3) 'nil)
  
  ; Function N
  
  (check (not 123) 'nil)
  (check (not "str") 'nil)
  (check (not nil) 't)
  (check (not '()) 't)
  
  (check (nth 3 '(a b c d e)) 'd)
  (check (nth 0 '(a b c d e)) 'a)
  (check (nth 5 '(a b c d e)) 'nil)
  
  (check (null '(a b c d e)) 'nil)
  (check (null 1.23) 'nil)
  (check (null "str") 'nil)
  (check (null 'nil) 't)
  (check (null '()) 't)
  
  (check (numberp 4) 't)
  (check (numberp 3.83) 't)
  (check (numberp "str") 'nil)
  
  (check (or nil 45 '()) 't)
  (check (or nil '()) 'nil)
  
  ; Function P
  
#;  (check 
           (progn
             (setq p (polar '(1 1 3.5) 0.785398 1.414214))
             (and (= (length p) 3)
                  (equal (car p) 2.0 0.0001)
                  (equal (cadr p) 2.0 0.0001))
           )
           't)
#;  (check 
           (progn
             (setq p (polar '(1 1) 0.785398 1.414214))
             (and (= (length p) 2)
                  (equal (car p) 2.0 0.0001)
                  (equal (cadr p) 2.0 0.0001))
           )
           't)
  
  (check (princ 2) 2)
#;  (check (princ) 'nil)
  
  (check (progn) 'nil)
  (check 
           (progn
             (+ 1 2)
             (- 3 2)
           )
           1)
  
#;  (check (prompt 1) 'nil)
  
  ; Function Q
  
  (check (quote (a b)) '(a b))
  
  ; Function R
 #| 
  (check (redraw nil 1) 'nil)
  (check (redraw) 'nil)
  
  (check (regapp "aa") "AA")
  (check (regapp "aa") 'nil)
 |# 
  (check (rem 42 12) 6)
  (check (rem 12.0 16) 12.0)
  (check (rem 26 7 2) 1)
  (check (rem) 0)
  
  (check 
           (progn
             (setq a 0)
             (repeat 4
               (setq a (+ a 10))
             )
           )
           40)
  
  (check (reverse '(a b c)) '(c b a))
  (check (reverse '((a) b c)) '(c b (a)))
#|  
  (check (rtos 0.3333 2 2) "0.33")
  (check (rtos 0.6666 2 2) "0.67")
  (check (rtos -0.6666 2 2) "-0.67")
  (check (rtos 0.6666 2 6) "0.666600")
  (check 
           (progn 
             (setvar "DIMZIN" 4) 
             (setq tt (rtos 0.6666 2 2))
             (setvar "DIMZIN" 0)
             tt
           )
           ".67")
  (check 
           (progn 
             (setvar "DIMZIN" 4) 
             (setq tt (rtos -0.6666 2 2))
             (setvar "DIMZIN" 0)
             tt
           )
           "-.67")
  (check 
           (progn 
             (setvar "DIMZIN" 8) 
             (setq tt (rtos 0.6666 2 6))
             (setvar "DIMZIN" 0)
             tt
           )
           "0.6666")
  (check 
           (progn 
             (setvar "DIMZIN" 8) 
             (setq tt (rtos 0.9999 2 2))
             (setvar "DIMZIN" 0)
             tt
           )
           "1")
  (check 
           (progn 
             (setvar "DIMZIN" 8)
             (setq tt (rtos 10.9999 2 2))
             (setvar "DIMZIN" 0)
             tt
           )
           "11")
  |#
  ; Function S
  
  (check (setq a 1) 1)
  (check (progn (setq a 2) a) 2)
  
#;  (check 
           (progn
             (setvar "OSMODE" 11)
             (getvar "OSMODE")
           )
           11)
  
  (check (sin 1.0) 0.841471)
  (check (sin 0.0) 0.0)
  
  (check (sqrt 4) 2.0)
  (check (sqrt 2.0) 1.41421)
  
  (check (strcase "Sample") "SAMPLE")
  (check (strcase "Sample" t) "sample")
  
  (check (strcat "a" "bout") "about")
  (check (strcat "a" "b" "c") "abc")
  (check (strcat "a" "" "b") "ab")
  (check (strcat) "")
  
  (check (strlen "abcd") 4)
  (check (strlen "ab") 2)
  (check (strlen "one" "two" "four") 10)
  (check (strlen) 0)
  (check (strlen "") 0)
  
  (check (subst 'qq 'b '(a b (c d) b)) '(a qq (c d) qq))
  (check (subst 'qq 'z '(a b (c d) b)) '(a b (c d) b))
  (check (subst 'qq '(c d) '(a b (c d) b)) '(a b qq b))
  (check (subst '(qq rr) '(c d) '(a b (c d) b)) '(a b (qq rr) b))
  (check (subst '(qq rr) 'z '(a b (c d) b)) '(a b (c d) b))
  
  (check (substr "abcde" 2) "bcde")
  (check (substr "abcde" 2 1) "b")
  (check (substr "abcde" 3 2) "cd")
  
  ; Function T
  
  (check (terpri) 'nil)
  ; this is a crude hack
#|  (check 
           (textbox '((1 . "Hello world."))) 
           '((0.0 0.0 0.0) (1.0 1.0 0.0)))
  (check (textpage) 'nil)
  (check (textscr) 'nil)
|#  
  (check (type 'a) 'SYM)
  (check (type 123) 'INT)
  (check (type 3.45) 'REAL)
  (check (type "str") 'STR)
  (check (type '(a b)) 'LIST)
  (check (type +) 'SUBR)
  (check (type nil) 'nil)
  (check (type (open "nnn" "w")) 'FILE)
  
  ; Function V
  
#;  (check (ver) "Visual LISP 2004 (en)")
  
  ; Function W
  
  (check 
           (progn
             (setq a 0)
             (while (< a 2)
               (princ 1)
               (setq a (+ a 1))))
           2)
  (check (write-char 67) 67)
  (check (write-line "abc") "abc")
  
  ; Function Z
  
  (check (zerop 0) 't)
  (check (zerop 0.0) 't)
  (check (zerop 0.0001) 'nil)
  
  ; Testing some special aspects
  (check 
           (progn
             (setq f (open "nnn" "w"))
             (write-line "abcd" f)
             (close f)
             (setq f (open "nnn" "r"))
             (setq l (read-line f))
             (close f)
             l
           )
           "abcd")
  #|(command "layer" "new" "aa" "")
  (command "layer" "new" "bb" "")
  (command "line" "0,0" "1,1" "")
  (setq elast (entlast))
  (defun ent? (s) (if s (= (substr s 1 13) "<Entity name:") nil))
  (check (ent? (entlast)) 't)
  (check (ent? (entnext)) 't)
  (check (entnext (entnext)) 'nil)
  (check (listp (entget (entlast))) 't)
  (check (ent? (entdel (entlast))) 't)
  (check (entnext) 'nil)
  (check (entlast) 'nil)
  (check (ent? (entdel elast)) 't)
  (check (ent? (entnext)) 't)
  (check (ent? (entlast)) 't)
  (check 
           (progn
             (setq elist (entget (entlast)))
             (entmod (subst '(8 . "aa")
                            (assoc 8 elist)
                            elist))
             (cdr (assoc 8 (entget (entlast))))
           )
           "aa")
  (check 
           (not (null (entmake '((0 . "LINE")
                                 (100 . "AcDbLine")
                                 (10 1.0 1.0 1.0)
                                 (11 2.0 2.0 2.0)))))
           't)
  (check (ent? (tblobjname "layer" "aa")) 't)
  (check (ent? (tblobjname "layer" "bb")) 't)
  (check (ent? (tblobjname "layer" "cc")) 'nil)
  (check (null (tblsearch "layer" "aa")) 'nil)
  (check (null (tblsearch "layer" "cc")) 't)
  (check 
           (progn 
             (tblsearch "layer" "bb" t)
             (null (tblnext "layer"))
           )
           't)
  
  (check 
           (progn
             (setq ss (ssget "x"))
             (type ss)
           )
           'PICKSET)
  (check (sslength ss) 10)
  (check (ent? (setq n (ssname ss 0))) 't)
  (check (type (ssdel n ss)) 'PICKSET)
  (check (ssdel n ss) nil)
  (check (ssmemb n ss) nil)
  (check (sslength ss) 9)
  (check (sslength (ssadd n ss)) 10)
  (check (ssget "x" '((0 . "text"))) nil)
  (check (sslength (ssget "x" '((0 . "line")))) 2)
|#
  
  ;;(get-profile-results)